home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue56 / System / RASBase.pas next >
Encoding:
Pascal/Delphi Source File  |  2000-03-01  |  2.7 KB  |  85 lines
  1. unit RASBase;
  2.  
  3. interface
  4.  
  5. uses
  6.     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
  7.  
  8. type
  9.     TRASBaseComponent = class (TComponent)
  10.     private
  11.         { Private declarations }
  12.         fErrorText: String;
  13.         fError: Integer;
  14.         fOnError: TNotifyEvent;
  15.         fRasLib, fRasExtensionsLib: THandle;
  16.         fWin2000, fWinNT4, fAvailable, fDummy1: Boolean;
  17.     protected
  18.         function GetProc (ProcName: PChar): Pointer;
  19.         function CallProc (Err: Integer): Boolean;
  20.         property Win2000: Boolean read fWin2000;
  21.         property WinNT4: Boolean read fWinNT4;
  22.     public
  23.         { Public declarations }
  24.         constructor Create (AOwner: TComponent); override;
  25.         destructor Destroy; override;
  26.         property ErrorText: String read fErrorText;
  27.         property Error: Integer read fError;
  28.     published
  29.         { Published declarations }
  30.         property Available: Boolean read fAvailable write fDummy1 stored False;
  31.         property OnError: TNotifyEvent read fOnError write fOnError;
  32.     end;
  33.  
  34. implementation
  35.  
  36.  
  37. // TRASBaseComponent
  38.  
  39. constructor TRASBaseComponent.Create (AOwner: TComponent);
  40. begin
  41.     Inherited Create (AOwner);
  42.     fRasLib := LoadLibrary ('rasapi32.dll');
  43.     fRasExtensionsLib := LoadLibrary ('rnaph.dll');
  44.     fAvailable := fRasLib <> 0;
  45.     fWin2000 := (Win32Platform = Ver_Platform_Win32_NT) and (Win32MajorVersion >= 5);
  46.     fWinNT4 := (Win32Platform = Ver_Platform_Win32_NT) and (Win32MajorVersion = 4);
  47. end;
  48.  
  49. destructor TRASBaseComponent.Destroy;
  50. begin
  51.     if fRasLib <> 0 then FreeLibrary (fRasLib);
  52.     if fRasExtensionsLib <> 0 then FreeLibrary (fRasExtensionsLib);
  53.     Inherited;
  54. end;
  55.  
  56. function TRASBaseComponent.GetProc (ProcName: PChar): Pointer;
  57. begin
  58.     Result := Nil;
  59.     if fAvailable then begin
  60.         Result := GetProcAddress (fRasLib, ProcName);
  61.         if (Result = Nil) and (fRasExtensionsLib <> 0) then
  62.             Result := GetProcAddress (fRasExtensionsLib, ProcName);
  63.     end;
  64. end;
  65.  
  66. function TRASBaseComponent.CallProc (Err: Integer): Boolean;
  67. var
  68.     szErr: array [0..1024] of Char;
  69.     RasGetErrorString: function (Err: Integer; Buff: PChar; BuffSize: Integer): Integer; stdcall;
  70. begin
  71.     fError := Err;  Result := Err = 0;
  72.     if Result then fErrorText := '' else begin
  73.        RasGetErrorString := GetProc ('RasGetErrorStringA');
  74.        if RasGetErrorString (Err, szErr, sizeof (szErr)) = 0 then fErrorText := szErr else begin
  75.            fErrorText := SysErrorMessage (Err);
  76.            if fErrorText = '' then fErrorText := Format ('Unknown error (%d)', [Err]);
  77.        end;
  78.  
  79.        fErrorText := 'RAS: ' + fErrorText;
  80.        if Assigned (fOnError) then fOnError (Self);
  81.     end;
  82. end;
  83.  
  84. end.
  85.